home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 7 / Amiga Format AFCD07 (Dec 1996, Issue 91).iso / serious / shareware / programming / emacs-complete / fsf / emacs / lisp / gnusmail.el < prev    next >
Lisp/Scheme  |  1994-07-05  |  8KB  |  225 lines
  1. ;;; gnusmail.el --- mail reply commands for GNUS newsreader
  2.  
  3. ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
  6. ;; Keywords: news
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; Provides mail reply and mail other window command using usual mail
  27. ;; interface and mh-e interface.
  28. ;; 
  29. ;; To use MAIL: set the variables gnus-mail-reply-method and
  30. ;; gnus-mail-other-window-method to gnus-mail-reply-using-mail and
  31. ;; gnus-mail-other-window-using-mail, respectively.
  32. ;;
  33. ;; To use MH-E: set the variables gnus-mail-reply-method and
  34. ;; gnus-mail-other-window-method to gnus-mail-reply-using-mhe and
  35. ;; gnus-mail-other-window-using-mhe, respectively.
  36.  
  37. ;;; Code:
  38.  
  39. (require 'gnus)
  40.  
  41. (autoload 'news-mail-reply "rnewspost")
  42. (autoload 'news-mail-other-window "rnewspost")
  43.  
  44. (autoload 'mh-send "mh-e")
  45. (autoload 'mh-send-other-window "mh-e")
  46. (autoload 'mh-find-path "mh-e")
  47. (autoload 'mh-yank-cur-msg "mh-e")
  48.  
  49. ;;; Mail reply commands of GNUS Summary Mode
  50.  
  51. (defun gnus-summary-reply (yank)
  52.   "Reply mail to news author.
  53. If prefix argument YANK is non-nil, original article is yanked automatically.
  54. Customize the variable gnus-mail-reply-method to use another mailer."
  55.   (interactive "P")
  56.   ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
  57.   ;; Stripping headers should be specified with mail-yank-ignored-headers.
  58.   (gnus-summary-select-article t t)
  59.   (switch-to-buffer gnus-article-buffer)
  60.   (widen)
  61.   (delete-other-windows)
  62.   (bury-buffer gnus-article-buffer)
  63.   (funcall gnus-mail-reply-method yank))
  64.  
  65. (defun gnus-summary-reply-with-original ()
  66.   "Reply mail to news author with original article.
  67. Customize the variable gnus-mail-reply-method to use another mailer."
  68.   (interactive)
  69.   (gnus-summary-reply t))
  70.  
  71. (defun gnus-summary-mail-forward ()
  72.   "Forward the current message to another user.
  73. Customize the variable gnus-mail-forward-method to use another mailer."
  74.   (interactive)
  75.   (gnus-summary-select-article)
  76.   (switch-to-buffer gnus-article-buffer)
  77.   (widen)
  78.   (delete-other-windows)
  79.   (bury-buffer gnus-article-buffer)
  80.   (funcall gnus-mail-forward-method))
  81.  
  82. (defun gnus-summary-mail-other-window ()
  83.   "Compose mail in other window.
  84. Customize the variable gnus-mail-other-window-method to use another mailer."
  85.   (interactive)
  86.   (gnus-summary-select-article)
  87.   (switch-to-buffer gnus-article-buffer)
  88.   (widen)
  89.   (delete-other-windows)
  90.   (bury-buffer gnus-article-buffer)
  91.   (funcall gnus-mail-other-window-method))
  92.  
  93.  
  94. ;;; Send mail using sendmail mail mode.
  95.  
  96. (defun gnus-mail-reply-using-mail (&optional yank)
  97.   "Compose reply mail using mail.
  98. Optional argument YANK means yank original article."
  99.   (news-mail-reply)
  100.   (gnus-overload-functions)
  101.   (if yank
  102.       (let ((last (point)))
  103.     (goto-char (point-max))
  104.     (mail-yank-original nil)
  105.     (goto-char last)
  106.     )))
  107.  
  108. (defun gnus-mail-forward-using-mail ()
  109.   "Forward the current message to another user using mail."
  110.   ;; This is almost a carbon copy of rmail-forward in rmail.el.
  111.   (let ((forward-buffer (current-buffer))
  112.     (subject
  113.      (concat "[" gnus-newsgroup-name "] "
  114.          ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
  115.          (or (gnus-fetch-field "Subject") ""))))
  116.     ;; If only one window, use it for the mail buffer.
  117.     ;; Otherwise, use another window for the mail buffer
  118.     ;; so that the Rmail buffer remains visible
  119.     ;; and sending the mail will get back to it.
  120.     (if (if (one-window-p t)
  121.         (mail nil nil subject)
  122.       (mail-other-window nil nil subject))
  123.     (save-excursion
  124.       (goto-char (point-max))
  125.       (insert "------- Start of forwarded message -------\n")
  126.       (insert-buffer forward-buffer)
  127.       (goto-char (point-max))
  128.       (insert "------- End of forwarded message -------\n")
  129.       ;; You have a chance to arrange the message.
  130.       (run-hooks 'gnus-mail-forward-hook)
  131.       ))))
  132.  
  133. (defun gnus-mail-other-window-using-mail ()
  134.   "Compose mail other window using mail."
  135.   (news-mail-other-window)
  136.   (gnus-overload-functions))
  137.  
  138.  
  139. ;;; Send mail using mh-e.
  140.  
  141. ;; The following mh-e interface is all cooperative works of
  142. ;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
  143. ;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
  144. ;; SHINGU).
  145.  
  146. (defun gnus-mail-reply-using-mhe (&optional yank)
  147.   "Compose reply mail using mh-e.
  148. Optional argument YANK means yank original article.
  149. The command \\[mh-yank-cur-msg] yank the original message into current buffer."
  150.   ;; First of all, prepare mhe mail buffer.
  151.   (let (from cc subject date to reply-to (buffer (current-buffer)))
  152.     (save-restriction
  153.       (gnus-article-show-all-headers)    ;I don't think this is really needed.
  154.       (setq from (gnus-fetch-field "from")
  155.         subject (let ((subject (or (gnus-fetch-field "subject")
  156.                        "(None)")))
  157.               (if (and subject
  158.                    (not (string-match "^[Rr][Ee]:.+$" subject)))
  159.               (concat "Re: " subject) subject))
  160.         reply-to (gnus-fetch-field "reply-to")
  161.         cc (gnus-fetch-field "cc")
  162.         date (gnus-fetch-field "date"))
  163.       (setq mh-show-buffer buffer)
  164.       (setq to (or reply-to from))
  165.       (mh-find-path)
  166.       (mh-send to (or cc "") subject)
  167.       (save-excursion
  168.     (mh-insert-fields
  169.      "In-reply-to:"
  170.      (concat
  171.       (substring from 0 (string-match "  *at \\|  *@ \\| *(\\| *<" from))
  172.       "'s message of " date)))
  173.       (setq mh-sent-from-folder buffer)
  174.       (setq mh-sent-from-msg 1)
  175.       ))
  176.   ;; Then, yank original article if requested.
  177.   (if yank
  178.       (let ((last (point)))
  179.     (mh-yank-cur-msg)
  180.     (goto-char last)
  181.     )))
  182.  
  183. ;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh
  184. ;; <itojun@ingram.mt.cs.keio.ac.jp>
  185.  
  186. (defun gnus-mail-forward-using-mhe ()
  187.   "Forward the current message to another user using mh-e."
  188.   ;; First of all, prepare mhe mail buffer.
  189.   (let ((to (read-string "To: "))
  190.      (cc (read-string "Cc: "))
  191.      (buffer (current-buffer))
  192.      subject)
  193.     ;;(gnus-article-show-all-headers)
  194.     (setq subject
  195.       (concat "[" gnus-newsgroup-name "] "
  196.           ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
  197.           (or (gnus-fetch-field "subject") "")))
  198.     (setq mh-show-buffer buffer)
  199.     (mh-find-path)
  200.     (mh-send to (or cc "") subject)
  201.     (save-excursion
  202.       (goto-char (point-max))
  203.       (insert "\n------- Forwarded Message\n\n")
  204.       (insert-buffer buffer)
  205.       (goto-char (point-max))
  206.       (insert "\n------- End of Forwarded Message\n")
  207.       (setq mh-sent-from-folder buffer)
  208.       (setq mh-sent-from-msg 1))))
  209.  
  210. (defun gnus-mail-other-window-using-mhe ()
  211.   "Compose mail other window using mh-e."
  212.   (let ((to (read-string "To: "))
  213.     (cc (read-string "Cc: "))
  214.     (subject (read-string "Subject: " (gnus-fetch-field "subject"))))
  215.     (gnus-article-show-all-headers)    ;I don't think this is really needed.
  216.     (setq mh-show-buffer (current-buffer))
  217.     (mh-find-path)
  218.     (mh-send-other-window to cc subject)
  219.     (setq mh-sent-from-folder (current-buffer))
  220.     (setq mh-sent-from-msg 1)))
  221.  
  222. (provide 'gnusmail)
  223.  
  224. ;;; gnusmail.el ends here
  225.